(*      Revision - Nataliia Bielova - 2011              *)

open Syntaxtree;;

(** Contains the functions to print the Abstract Syntax Tree *)

(** Prints an ide
    @param Ide(s) The ide to print
*)
let print_ide (Ide(s)) = "Ide("^s^")"

(* LDL: define the function that prints AST Record expressions *)
let print_record r =
  let rec print_ide_list il = match il with
      []    ->  ""
    | x::xs ->  (print_ide x) ^ "\t" ^ (print_ide_list xs)
  in
  match r with
    | Record(idelist) -> "Record("^print_ide_list idelist^")"

(* LDL: define the function that prints AST pointer expressions *)
(** Prints a pointer expression
    @param Ide(s) The ide to print
*)
let rec print_pexp pexp = match pexp with
    PVar(ide) -> "PVar("^ (print_ide ide) ^")"
  | Ref(pexp) -> "Ref("^ (print_pexp pexp) ^")"
  | Deref(pexp) -> "Deref("^ (print_pexp pexp) ^")"
(** Prints a list of string
    @param al The string list to print
*)
and print_string_list (al: string list) = match al with
    []    ->  ""
  | x::xs ->  x ^ "\t" ^ (print_string_list xs)

(** Prints arithmetical expressions
    @param a The aexp to print
*)
(* LDL: add the print for P(pexp), Ox(o) and PNull and Rec *)
and print_aexp  (a: aexp) = match a with
    N(n)              ->  "N("^ (string_of_int n) ^")"
  | R(f)              ->  "R("^ (string_of_float f) ^")"
  | Ox(o)             ->  "Ox("^ (string_of_offset o) ^")"
  | PNull             ->  "PNull"
  | Var(id)           ->  "Var("^ (print_ide id) ^")"
  | P(pexp)           ->  "P("^ (print_pexp pexp) ^")"
  | Rec(r)            ->  "Rec("^ (print_record r) ^")"
  | Vec(id,ex)        ->  "Vec("^ (print_ide id) ^","^ (print_aexp ex) ^")"
  | Mat(id,ex1,ex2)   ->  "Mat("^ (print_ide id) ^","^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"
  | Sum(ex1,ex2)      ->  "Sum("^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"
  | Sub(ex1,ex2)      ->  "Sub("^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"
  | Mul(ex1,ex2)      ->  "Mul("^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"
  | Div(ex1,ex2)      ->  "Div("^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"
  | FCall(id,exl)     ->  "FCall("^ (print_ide id) ^",["^ (print_string_list(List.map print_actual exl)) ^"])"
(** Prints boolean expressions
    @param b The bexp to print
*)
and print_bexp (b: bexp) = match b with
    B(b)              ->  if(b) then "B(true) " else "B(false)"
  | Equ(ex1,ex2)      ->  "Equ(" ^ (print_aexp ex1)^ "," ^(print_aexp ex2)^")"
  | LE(ex1,ex2)       ->  "LE(" ^ (print_aexp ex1)^ "," ^(print_aexp ex2)^")"
  | LT(ex1,ex2)       ->  "LT(" ^ (print_aexp ex1)^ "," ^(print_aexp ex2)^")"
  | Not(bex)          ->  "Not(" ^ (print_bexp bex) ^ ")"
  | And(bex1,bex2)    ->  "And(" ^ (print_bexp bex1) ^ "," ^ (print_bexp bex2) ^ ")"
  | Or(bex1,bex2)     ->  "Or(" ^ (print_bexp bex1) ^ "," ^ (print_bexp bex2) ^ ")"

(* LDL: since we defined the new type for actual parameters we also
        have to provide a function to print an actual parameter
*)
(** Prints an actual parameter
    @param ae The actual parameter to print
*)
and print_actual (ae: actual) = match ae with
    ParamAexp(aexp)  ->  "ParamAexp("^ (print_aexp aexp) ^")"
  | ParamPexp(pexp)  ->  "ParamPexp("^ (print_pexp pexp) ^")"

(** Prints left expressions
    @param l The lexp to print
*)
(* LDL: add the print for LPexpr *)
let print_lexp (l: lexp) = match l with
    LVar(id)          ->  "LVar("^ (print_ide id) ^")"
  | LPexpr(pexp)      ->  "LPexpr("^ (print_pexp pexp) ^")"
  | LRec(r)           ->  "LRec("^ (print_record r) ^")"
  | LVec(id,ex)       ->  "LVec("^ (print_ide id) ^","^ (print_aexp ex) ^")"
  | LMat(id,ex1,ex2)  ->  "LMat("^ (print_ide id) ^","^ (print_aexp ex1) ^","^ (print_aexp ex2) ^")"

(** Prints commands
    @param c The command to print
*)
(* LDL: add the print for PAss(l, r) *)
let rec print_cmd (c: cmd) = match c with
    Ass(l,r)          ->  "\tAss(" ^ (print_lexp l) ^ "," ^ (print_aexp r) ^ ")\n"
  | PAss(l,r)         ->  "\tPAss(" ^ (print_lexp l) ^ "," ^ (print_pexp r) ^ ")\n"
  | Blk(clist)        ->  "Blk(\n\t" ^ (print_string_list (List.map print_cmd clist)) ^ ")\n"
  | Ite(b,c1,c2)      ->  "\tIte(" ^ (print_bexp b) ^ "," ^ (print_cmd c1) ^ "," ^ (print_cmd c2) ^ ")\n"
  | While(b,c)        ->  "\tWhile(" ^ (print_bexp b) ^ "," ^ (print_cmd c) ^ ")\n"
  | Repeat(c,b)       ->  "\tRepeat(" ^ (print_cmd c) ^ "," ^ (print_bexp b) ^ ")\n"
  | For(i,ex1,ex2,c)  ->  "\tFor(" ^ (print_ide i) ^ "," ^ (print_aexp ex1) ^ "," ^ (print_aexp ex2) ^ "," ^ (print_cmd c) ^ ")\n"
  | Write(ex)         ->  "\tWrite(" ^ (print_aexp ex) ^ ")\n"
  | PCall(id,exl)     ->  "\tPCall("^ (print_ide id) ^",["^ (print_string_list (List.map print_actual exl)) ^"])\n"

(* LDL: brand new function for printing user defined new types *)
let print_usrType ut = match ut with
    UsrRecord(r) -> "UsrRecord(" ^ (print_record r) ^ ")"

(** Prints basic Type
    @param b The basic Type to print
*)
let print_bType (b: bType) = match b with
    Int    ->  "Int"
  | Float  ->  "Float"
  | UsrType(ut) -> "UsrType(" ^ (print_usrType ut) ^ ")"

(** Prints generic Type
    @param g The generic Type to print
*)
(* LDL: add the print for Pointer(g). This implies setting the function recursive. *)
let rec print_gType (g: gType) = match g with
    Basic(b)      ->  "Basic(" ^ (print_bType b) ^ ")"
  | Pointer(g)    ->  "Pointer(" ^ (print_gType g) ^ ")"
  | Vector(n,b)   ->  "Vector(" ^ (string_of_int n) ^ "," ^ (print_bType b) ^ ")"
  | Matrix(n,m,b) ->  "Matrix(" ^ (string_of_int n) ^ "," ^ (string_of_int m) ^ "," ^ (print_bType b) ^ ")"

(* LDL: add the function to print the record field definition *)
(** Prints a record field definition
    @param g The record field to print
*)
let print_rec_field rf = match rf with
    TRecordField(ide, bt) -> (print_ide ide) ^ "," ^ (print_bType bt) ^ ")"

(* LDL: add the function to print type_s*)
(** Prints type_ (= type definition body)
    @param g The type_ to print
*)
let print_type_ (t: type_) = 
  let rec print_field_list fl = match fl with
      []    ->  ""
    | x::xs ->  (print_rec_field x) ^ "\t" ^ (print_field_list xs)
  in
  match t with
      TRecord(field_list) -> "TRecord(" ^ (print_field_list field_list) ^ ")"


(* LDL: add the function to print type definitions *)
(** Prints a type definition
    @param TypeDec(id,tp) The type declaration to print
*)
let print_typedef (TypeDef(id,tp): type_def) = "TypeDef(" ^ (print_ide id) ^ "," ^ (print_type_ tp) ^ ")\n"

(** Prints a declaration
    @param Dec(id,gt) The declaration to print
*)
let print_dec (Dec(id,gt): dec) = "Dec(" ^ (print_ide id) ^ "," ^ (print_gType gt) ^ ")\n"

(** Prints Parameters of functions/procedures
    @param Par(id,bt) The param to print
*)
(* LDL: use the gType printing functions for parameter types *)
let print_param (Par(id, gt): param) = "Par(" ^ (print_ide id) ^ "," ^ (print_gType gt) ^ ")\n"

(** Prints the return value of functions
    @param Ret(b) The return value to print
*)
let print_ret (Ret(b)) = "Ret(" ^ (print_bType b) ^ ")"

(** Prints The definition of procedures and functions
    @param s The procedure/function to print
*)
let print_proc (s: proc) = match s with
    Proc(id,plist,dlist,c)      ->  "\rProc(" ^ (print_ide id) ^ ",\n\t" ^
      (print_string_list (List.map print_param plist)) ^
      (print_string_list (List.map print_dec dlist)) ^ "\n\t" ^
      (print_cmd c) ^ ")\n\n"
  | Func(id,plist,r,dlist,c)    ->  "\rFunc(" ^ (print_ide id) ^ ", " ^
    (print_ret r) ^ "\t" ^
    (print_string_list (List.map print_param plist)) ^ "\n\t" ^
    (print_string_list (List.map print_dec dlist)) ^ "\n\t" ^
    (print_cmd c) ^ ")\n\n"

(** Prints the Abstract Syntax Tree
    @param p The AST
    @param out The output channel
*)
(* LDL: modify it to allow type declaration lists *)
let print_program (p: program) (out: out_channel) = match p with
    Program(type_def_list,dlist,plist,c) ->  output_string out
      ("Program(\n\t" ^ 
	  (print_string_list (List.map print_typedef type_def_list)) ^ "\n" ^
	  (print_string_list (List.map print_dec dlist)) ^ "\n" ^
          (print_string_list (List.map print_proc plist)) ^ "\n" ^
          (print_cmd c) ^ "\n)")
  | SynError                ->  output_string out "SynError"
